home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / prog / mod2tutb.zip / REAL2MON.MOD < prev    next >
Text File  |  1989-01-18  |  3KB  |  96 lines
  1. IMPLEMENTATION MODULE Real2Mon;
  2.  
  3. (*         Copyright (c) 1987, 1989 - Coronado Enterprises         *)
  4.  
  5. FROM InOut IMPORT Write;
  6.  
  7. VAR OutString : ARRAY[0..80] OF CHAR;
  8.  
  9. (* This procedure uses a rather lengthy method for decomposing the *)
  10. (* REAL number and forming it into single characters.  There may   *)
  11. (* be a procedure in your compilers library to do this for you     *)
  12. (* but this method is kept as an example of how to decompose the   *)
  13. (* number to prepare it for output.  It could be much more effi-   *)
  14. (* cient to use your compilers library call.                       *)
  15.  
  16. PROCEDURE WriteReal(DataOut  : REAL;
  17.                     FieldSize : CARDINAL;
  18.                     Digits    : CARDINAL);
  19.  
  20. VAR Index          : CARDINAL;
  21.     Field          : CARDINAL;
  22.     Count          : CARDINAL;
  23.     WholeFieldSize : CARDINAL;
  24.     ABSDataOut     : REAL;
  25.     Char           : CHAR;
  26.     RoundReal      : REAL;
  27.  
  28. BEGIN
  29.    IF DataOut >= 0.0 THEN   (* Get the absolute value to work with *)
  30.       ABSDataOut := DataOut;
  31.    ELSE
  32.       ABSDataOut := -DataOut;
  33.    END;
  34.  
  35.                          (* Make sure the Digits field is positive *)
  36.    IF Digits < 0 THEN
  37.       Digits := 0;
  38.    END;
  39.  
  40.         (* Make sure there are 3 or more digits for the whole part *)
  41.    IF (FieldSize - Digits) < 3 THEN
  42.       FieldSize := Digits + 3;
  43.    END;
  44.  
  45.    RoundReal := 0.5;         (* This is used for rounding the data *)
  46.    IF Digits = 0 THEN
  47.       WholeFieldSize := FieldSize;
  48.    ELSE
  49.       WholeFieldSize := FieldSize - Digits - 1;
  50.       FOR Count := 1 TO Digits DO
  51.          RoundReal := RoundReal * 0.1;    (* Reduce for each digit *)
  52.       END;
  53.    END;
  54.    ABSDataOut := ABSDataOut + RoundReal;    (* Add rounding amount *)
  55.  
  56.    Count := 0;
  57.    WHILE ABSDataOut >= 1.0 DO
  58.       Count := Count + 1;              (* Count significant digits *)
  59.       ABSDataOut := 0.1 * ABSDataOut;
  60.    END;
  61.  
  62.    WHILE WholeFieldSize > (Count + 1) DO  (* Output leading blanks *)
  63.       Write(" ");
  64.       WholeFieldSize := WholeFieldSize - 1;
  65.    END;
  66.  
  67.    IF DataOut >= 0.0 THEN          (* Output the sign (- or blank) *)
  68.       Write(" ");
  69.    ELSE
  70.       Write("-");
  71.    END;
  72.  
  73.    WHILE Count > 0 DO       (* Output the whole part of the number *)
  74.       ABSDataOut := 10.0 * ABSDataOut;
  75.       Index := TRUNC(ABSDataOut);
  76.       Char := CHR(Index + 48);                   (* 48 = ASCII '0' *)
  77.       Write(Char);
  78.       ABSDataOut := ABSDataOut - FLOAT(Index);
  79.       Count := Count - 1;
  80.    END;
  81.  
  82.    IF Digits > 0 THEN  (* Output the fractional part of the number *)
  83.       Write('.');
  84.       FOR Count := 1 TO Digits DO
  85.          ABSDataOut := 10.0 * ABSDataOut;
  86.          Index := TRUNC(ABSDataOut);
  87.          Char := CHR(Index + 48);                (* 48 = ASCII '0' *)
  88.          Write(Char);
  89.          ABSDataOut := ABSDataOut - FLOAT(Index);
  90.       END;
  91.    END;
  92. END WriteReal;
  93.  
  94. END Real2Mon.
  95.  
  96.